Declare Function SystemParametersInfo Lib "User" (ByVal uAction As Integer, ByVal uParam As Integer, ByVal lpvParam As String, ByVal fuWinIni As Integer) As Integer
Declare Function GIFToBMP Lib "giftobmp.dll" (ByVal lpstrGIF As String, ByVal lpstrBMP As String) As Integer
Dim Connected, DoneIt, EastFlag, StartMinuite
Sub dsSocket1_Connect ()
'-- Set the connected flag
Connected = True
End Sub
Sub dsSocket1_Exception (ErrorCode As Integer, ErrorDesc As String)
If ErrorCode = DSSOCK_DISCONNECTED Then
'-- We've disconnected
Connected = False
End If
End Sub
Sub dsSocket1_Receive (ReceiveData As String)
'-- This routine occurs when we're receiving a file.
'-- If this is the beginning of the GIF file, then
' the block starts with the letters "GIF"
If Left$(ReceiveData, 3) = "GIF" Then
'-- Open the GIF File
SrcFile$ = App.Path & "\WMAP.GIF"
Open SrcFile$ For Output As 1
Close 1
Open SrcFile$ For Binary As 1
End If
'-- Write the data
Put #1, , ReceiveData
'-- Is the transfer complete?
If Asc(Right$(ReceiveData, 1)) = 59 Then
'-- Yes. Close the file
Close 1
'-- Convert the GIF file to a BMP file using
' Dolphin Systems' simple GIF2BMP converter
DestFile$ = App.Path & "\WMAP.BMP"
SrcFile$ = App.Path & "\WMAP.GIF"
ErrCode = GIFToBMP(SrcFile$, DestFile$)
'-- If there were no problems, change the
' Windows wallpaper to the new bitmap
If ErrCode = 0 Then
Dummy = SystemParametersInfo(20, 0, DestFile$, 1)
'-- Tell everyone that we've done it for this hour.
DoneIt = True
End If
'-- Close the connection
dsSocket1.Action = DSSOCK_CLOSE
'-- Wait until we're not connected
Do
DoEvents
Loop Until Not Connected
'-- Re-enable the timer
Timer1.Enabled = True
End If
End Sub
Sub Form_Load ()
'-- /E on the command line tells WMAP to
' retrieve the eastern US photo instead of
' the western US
C$ = Trim$(UCase$(Command$))
EastFlag = InStr(C$, "/E")
'-- Record the minutes past the hour right now
StartMinuite = Minute(Now)
'-- Use a large buffer size
dsSocket1.DataSize = 30000
'-- Go get the latest photo now.
GetPicture
End Sub
Sub Form_Unload (Cancel As Integer)
'-- Disconnect (even if we're not connected)
On Error Resume Next
dsSocket1.Action = DSSOCK_CLOSE
End
End Sub
Sub GetPicture ()
'-- This routine connects to the gopher weather server and sends the
' command to retrieve the latest weather map .GIF file
'-- Temporarily disable the timer
Timer1.Enabled = False
'-- Set the port and address
dsSocket1.RemotePort = 70
dsSocket1.RemoteHost = "wx.atmos.uiuc.edu"
'-- Catch any errors that result from trying to connect
On Error Resume Next
dsSocket1.Action = DSSOCK_CONNECT
If Err Then
'-- An error occurred. Try again at the next timer
Timer1.Enabled = True
Exit Sub
End If
'-- No errors. Wait until we've connected
Do
DoEvents
Loop Until Connected
'-- Send the command to retrieve either the eastern or western US weather map.
If EastFlag Then
dsSocket1.Send = "9/Images/Satellite Images/Satellite East IR/00LATEST.GIF" & Chr$(13) & Chr$(10)
Else
dsSocket1.Send = "9/Images/Satellite Images/Satellite West IR/00LATEST.GIF" & Chr$(13) & Chr$(10)
(.txt)